home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / AmigaE / Src / Utils / EDBG / eexe.e < prev    next >
Encoding:
Text File  |  1997-10-11  |  10.9 KB  |  499 lines

  1. /* E executable load and debug objects
  2.  
  3. probs: all that uses task-structure
  4. - Forbid(): broken by debugger?
  5. etc.
  6.  
  7. */
  8.  
  9. OPT MODULE
  10.  
  11. MODULE 'exec/tasks', 'dos/doshunks'
  12. MODULE 'tools/file'
  13.  
  14. /*---------------load-e-exe-functions------------------*/
  15.  
  16. EXPORT OBJECT e_exe PRIVATE
  17.   file,code,codelen,sources:PTR TO e_source
  18. ENDOBJECT
  19.  
  20. EXPORT OBJECT e_source PRIVATE
  21.   next:PTR TO e_source
  22.   lines:PTR TO LONG,numlines        -> of LINEDEBUG info
  23.   sourcename,source
  24.   procs:PTR TO e_proc
  25.   globs:PTR TO e_var
  26.   sourcelines:PTR TO LONG
  27. ENDOBJECT
  28.  
  29. PROC sources() OF e_exe IS self.sources
  30. PROC next() OF e_source IS self.next
  31. PROC name() OF e_source IS self.sourcename
  32. PROC lines() OF e_source IS self.sourcelines
  33.  
  34. OBJECT e_proc PRIVATE
  35.   next:PTR TO e_proc
  36.   name:PTR TO CHAR
  37.   firstvarline
  38.   vars:PTR TO e_var
  39. ENDOBJECT
  40.  
  41. EXPORT OBJECT e_var PRIVATE
  42.   next:PTR TO e_var
  43.   name:PTR TO CHAR
  44. PUBLIC
  45.   regno:INT,offs:INT    -> if 0 then other
  46.   type:PTR TO CHAR
  47. ENDOBJECT
  48.  
  49. PROC findsrc(name) OF e_source
  50.   WHILE self
  51.     IF StrCmp(self.sourcename,name) THEN RETURN self
  52.     self:=self.next
  53.   ENDWHILE
  54. ENDPROC NIL
  55.  
  56. PROC locate(vx,vy,var) OF e_source
  57.   DEF l,l2,c
  58.   IF (vy<0) OR (vy>=ListLen(self.sourcelines))
  59.     vy:=-1
  60.   ELSE
  61.     l:=self.sourcelines[vy]
  62.     vx:=Bounds(vx,0,StrLen(l))
  63.     l:=l+vx
  64.     IF isalnum(l[])
  65.       l2:=l
  66.       WHILE isalnum(l[-1]) DO l--
  67.       WHILE isalnum(l2[]) DO l2++
  68.       IF ((c:=l[])>="_") AND (c<="z") THEN StrCopy(var,l,l2-l)
  69.     ENDIF
  70.   ENDIF
  71. ENDPROC vy
  72.  
  73. PROC isalnum(c) IS ((c>="A") AND (c<="Z")) OR ((c>="_") AND (c<="z")) OR ((c>="0") AND (c<="9"))
  74.  
  75. PROC findproc(linenum) OF e_source
  76.   DEF pr:PTR TO e_proc
  77.   pr:=self.procs
  78.   WHILE pr
  79.     EXIT IF pr.vars THEN pr.firstvarline<=linenum ELSE FALSE
  80.     pr:=pr.next
  81.   ENDWHILE
  82. ENDPROC pr
  83.  
  84. PROC findvar(name,pr=NIL:PTR TO e_proc) OF e_source
  85.   DEF var=NIL:PTR TO e_var,isglob=FALSE
  86.   IF pr THEN var:=lookupvar(pr.vars,name)
  87.   IF var=NIL THEN (isglob:=TRUE) BUT var:=lookupvar(self.globs,name)
  88. ENDPROC var,isglob
  89.  
  90. PROC lookupvar(v:PTR TO e_var,name)
  91.   WHILE v
  92.     IF StrCmp(v.name,name) THEN RETURN v
  93.     v:=v.next
  94.   ENDWHILE
  95. ENDPROC NIL
  96.  
  97. PROC grabvarinfo(src:PTR TO e_source,o:PTR TO INT,end)
  98.   DEF pr=NIL:PTR TO e_proc,job,v
  99.   WHILE (job:=o[]++) BUT o<end
  100.     SELECT 6 OF job
  101.       CASE 1,2
  102.         o,v:=collectvars(o,pr.vars,src,pr,job)
  103.         pr.vars:=v
  104.       CASE 3
  105.         o,v:=collectvars(o,src.globs,src,pr,job)
  106.         src.globs:=v
  107.       CASE 4
  108.         NEW pr
  109.         v:=o[]++
  110. ->WriteF('\nPROC \s:',o)
  111.         pr.name:=o
  112.         pr.firstvarline:=-1
  113.         pr.next:=src.procs    -> in reverse order, for line-search
  114.         src.procs:=pr
  115.         o:=o+v
  116.       CASE 5
  117.         v:=o[]++
  118.         newself(pr,o[],o[1])
  119.         o:=o+v
  120.       DEFAULT
  121.         Raise("eexe")
  122.     ENDSELECT
  123.   ENDWHILE
  124. ->WriteF('\n')
  125. ENDPROC
  126.  
  127. CONST REGVARLIM=30000
  128.  
  129. PROC newself(pr:PTR TO e_proc,linenum,b)
  130.   DEF i,t
  131.   IF (i:=InStr(pr.name,':'))=-1 THEN Raise("eexe")
  132.   i++
  133.   NEW t[i]
  134.   AstrCopy(t,pr.name,i)
  135.   pr.vars:=NEW [pr.vars,'self',IF b>=REGVARLIM THEN b-REGVARLIM ELSE 0,
  136.                 IF b>=REGVARLIM THEN 0 ELSE b,t]:e_var
  137.   pr.firstvarline:=linenum
  138. ->WriteF('new self "\s"\n',t)
  139. ENDPROC
  140.  
  141. PROC collectvars(o:PTR TO INT,varlist,src:PTR TO e_source,pr:PTR TO e_proc,job)
  142.   DEF line,v:PTR TO e_var,num,a,b,s:PTR TO CHAR,st,t
  143.   v:=varlist
  144.   line:=o[]++
  145.   s:=src.sourcelines[line]
  146.   num:=o[]++
  147.   IF pr THEN IF pr.firstvarline<0 THEN pr.firstvarline:=line
  148.   FOR a:=1 TO num
  149.     b:=o[]++
  150.     v:=NEW [v,NIL,IF b>=REGVARLIM THEN b-REGVARLIM ELSE 0,IF b>=REGVARLIM THEN 0 ELSE b,NIL]:e_var
  151. ->WriteF(' $\h ',b)
  152.     IF (a=1) AND (job=1) THEN WHILE s[]++<>"(" DO NOP
  153.     IF a>1 THEN WHILE s[]++<>"," DO NOP
  154.     WHILE ((b:=s[])<"_") OR (b>"z") DO s++
  155.     st:=s
  156.     REPEAT
  157.       s++
  158.     UNTIL isalnum(s[])=FALSE
  159.     b:=s-st+1
  160.     NEW t[b]
  161.     AstrCopy(t,st,b)
  162. ->WriteF('(\s)',t)
  163.     v.name:=t
  164.     t:=FALSE
  165.     WHILE (b:=s[]) AND (b<>",")
  166.     EXIT t:=((b>="_") AND (b<="z"))
  167.       s++
  168.     ENDWHILE
  169.     IF t
  170.       st:=s
  171.       REPEAT
  172.         s++
  173.       UNTIL isalnum(s[])=FALSE
  174.       b:=s-st+1
  175.       NEW t[b]
  176.       AstrCopy(t,st,b)
  177.       v.type:=t
  178.     ENDIF
  179.   ENDFOR
  180. ENDPROC o,v
  181.  
  182. PROC load(name) OF e_exe
  183.   DEF o:PTR TO LONG,l,cl,c,dbl,numrel,a,b:PTR TO LONG,src=NIL:PTR TO e_source,add
  184.  
  185.   -> read exe
  186.  
  187.   o,l:=readfile(name,0)
  188.   self.file:=o
  189.  
  190.   -> eat header
  191.  
  192.   IF (o[]++<>HUNK_HEADER) OR (o[]++<>0) OR (o[]++<>1) OR (o[]++<>0) OR (o[]++<>0) THEN Raise("eexe")
  193.   o++
  194.  
  195.   -> eat code hunk
  196.  
  197.   IF o[]++<>HUNK_CODE THEN Raise("eexe")
  198.   self.codelen:=cl:=o[]++*4
  199.   self.code:=c:=o
  200.   o:=o+cl
  201.  
  202.   -> eat and digest reloc
  203.  
  204.   IF o[]++<>HUNK_RELOC32 THEN Raise("eexe")
  205.   numrel:=o[]++
  206.   IF o[]++<>0 THEN Raise("eexe")
  207.   IF numrel
  208.     FOR a:=1 TO numrel                -> do own reloc!
  209.       b:=c+o[]++
  210.       b[]:=b[]+c
  211.     ENDFOR
  212.   ENDIF
  213.   IF o[]++<>0 THEN Raise("eexe")
  214.  
  215.   -> skip symbol hunk if necessary
  216.  
  217.   IF o[]=HUNK_SYMBOL
  218.     o++
  219.     WHILE a:=o[]++ DO o:=a*4+o+4
  220.   ENDIF
  221.  
  222.   -> eat debug hunks
  223.  
  224.   IF o[]<>HUNK_DEBUG THEN Raise("eexd")
  225.  
  226.   WHILE (a:=o[]++)<>HUNK_END
  227.     IF a=HUNK_DEBUG
  228.       IF o[2]="EVAR"
  229.         IF src=NIL THEN Raise("eexe")
  230.         dbl:=o[]++
  231.         grabvarinfo(src,o+8,o:=dbl*4+o)
  232.       ELSE
  233.         NEW src
  234.         dbl:=o[]++
  235.         IF (o[]++<>0) THEN Raise("eexe")
  236.         IF o[]="LINE"
  237.           add:=0
  238.         ELSEIF Char(o)="L"
  239.           add:=o[] AND $FFFFFF
  240.         ELSE
  241.           Raise("eexe")
  242.         ENDIF
  243.         o++
  244.         src.numlines:=dbl:=dbl-(a:=o[]++)-3
  245.         src.sourcename:=o
  246.         o:=a*4+o
  247.         src.lines:=o
  248.         make_illegal(c,o,dbl,add)
  249.         o:=dbl*4+o
  250.         src.next:=self.sources
  251.         self.sources:=src
  252.         src.load()
  253.         src.globs:=add_globs(src.globs)
  254.       ENDIF
  255.     ELSE
  256.       Raise("eexe")
  257.     ENDIF
  258.   ENDWHILE
  259.  
  260.   CacheClearU()                    -> important!
  261.  
  262. ENDPROC
  263.  
  264. PROC new_var(v,s,off,type=NIL) IS NEW [v,s,0,off,type]:e_var
  265.  
  266. PROC add_globs(v)
  267.   v:=new_var(v,'stdout',       -$8)
  268.   v:=new_var(v,'conout',       -$C)
  269.   v:=new_var(v,'stdrast',      -$10, 'rastport')
  270.   v:=new_var(v,'arg',          -$20)
  271.   v:=new_var(v,'wbmessage',    -$24, 'wbstartup')
  272.   v:=new_var(v,'execbase',     -$28, 'execbase')
  273.   v:=new_var(v,'dosbase',      -$2C, 'doslibrary')
  274.   v:=new_var(v,'intuitionbase',-$30, 'intuitionbase')
  275.   v:=new_var(v,'gfxbase',      -$34, 'gfxbase')
  276.   v:=new_var(v,'exception',    -$54)
  277.   v:=new_var(v,'stdin',        -$5C)
  278.   v:=new_var(v,'exceptioninfo',-$60)
  279. ENDPROC v
  280.  
  281. CONST OPCODE_NOP=$4E71, OPCODE_ILLEGAL=$4AFC
  282.  
  283. PROC make_illegal(code,dbg:PTR TO LONG,len,add)
  284.   DEF a,b:PTR TO INT
  285.   IF len
  286.     FOR a:=1 TO len STEP 2
  287.       dbg++
  288.       dbg[]++:=b:=dbg[]+add
  289.       b:=b+code
  290.       IF b[]<>OPCODE_NOP THEN Raise("eexd")
  291.       b[]:=OPCODE_ILLEGAL
  292.     ENDFOR
  293.   ENDIF
  294. ENDPROC
  295.  
  296. PROC end() OF e_exe
  297.   DEF p:PTR TO e_source
  298.   IF self.file THEN freefile(self.file)
  299.   p:=self.sources
  300.   END p
  301. ENDPROC    
  302.  
  303. PROC load() OF e_source
  304.   DEF m,l,a,p
  305.   m,l:=readfile(self.sourcename)
  306.   self.source:=m
  307.   self.sourcelines:=stringsinfile(m,l,countstrings(m,l))
  308.   p:=m
  309.   FOR a:=1 TO l DO IF p[]++="\t" THEN p[-1]:=" "
  310. ENDPROC
  311.  
  312. PROC end() OF e_source
  313.   DEF n:PTR TO e_source
  314.   n:=self.next
  315.   IF self.source THEN freefile(self.source)
  316.   END n
  317. ENDPROC
  318.  
  319. PROC findline(pc) OF e_exe
  320.   DEF l:PTR TO e_source,a,b,dbg:PTR TO LONG,num,c
  321.   l:=self.sources
  322.   c:=self.code
  323.   WHILE l
  324.     dbg:=l.lines
  325.     num:=l.numlines-1
  326.     FOR a:=0 TO num STEP 2
  327.       b:=dbg[]++-1
  328.       IF dbg[]+++c=pc THEN RETURN l,b
  329.     ENDFOR
  330.     l:=l.next
  331.   ENDWHILE
  332.   MOVE.L lastpc(PC),a
  333. ENDPROC NIL,NIL,a
  334.  
  335. CONST STARTUP_SIZE=$196
  336.  
  337. PROC findoffset(off) OF e_exe
  338.   DEF l:PTR TO e_source,a,b,dbg:PTR TO LONG,num,best=0,src=NIL,line,start=0,largest=0
  339.   IF (off<0) OR (off>=self.codelen) THEN RETURN NIL
  340.   l:=self.sources
  341.   WHILE l
  342.     dbg:=l.lines
  343.     num:=l.numlines-1
  344.     IF largest<dbg[num]
  345.       start:=dbg[1]
  346.       largest:=dbg[num]
  347.     ENDIF
  348.     FOR a:=0 TO num STEP 2
  349.       b:=dbg[]++-1
  350.     EXIT off<dbg[]
  351.       IF dbg[]>best
  352.         best:=dbg[]
  353.         line:=b
  354.         src:=l
  355.       ENDIF
  356.       dbg++
  357.     ENDFOR
  358.     l:=l.next
  359.   ENDWHILE
  360.   IF (off<STARTUP_SIZE) OR ((start-$12<=off) AND (off<start))
  361.     src:=NIL
  362.   ELSEIF off>(largest+8)
  363.     best:=TRUE
  364.   ELSE
  365.     best:=FALSE
  366.   ENDIF
  367. ENDPROC src,line,best
  368.  
  369. PROC findpc(line,exe:PTR TO e_exe) OF e_source
  370.   DEF a,dbg:PTR TO LONG,num,c
  371.   c:=exe.code
  372.   dbg:=self.lines
  373.   num:=self.numlines-1
  374.   FOR a:=0 TO num STEP 2 DO IF dbg[]++-1=line THEN RETURN dbg[]+c ELSE dbg++
  375. ENDPROC NIL
  376.  
  377. PROC edebug(do_at_break,cli_arg) OF e_exe
  378.   DEF mytask:PTR TO tc,code,alen
  379.   alen:=StrLen(cli_arg)+1
  380.   mytask:=FindTask(NIL)
  381.   mytask.trapcode:={tcode}
  382.   LEA codejmp(PC),A0
  383.   MOVE.L do_at_break,(A0)
  384.   LEA debuga4(PC),A0
  385.   MOVE.L A4,(A0)
  386.   code:=self.code
  387.   MOVEM.L D0-D7/A0-A6,-(A7)
  388.   MOVE.L cli_arg,A0
  389.   MOVE.L alen,D0
  390.   MOVE.L code,A1
  391.   JSR (A1)
  392.   MOVEM.L (A7)+,D0-D7/A0-A6
  393. ENDPROC
  394.  
  395. EXPORT OBJECT stackframe PUBLIC
  396.   status:LONG
  397.   regs[15]:ARRAY OF LONG
  398.   returnpc:LONG
  399.   stack[1]:ARRAY OF LONG    -> from here on
  400. ENDOBJECT
  401.  
  402. tcode:
  403.   CMP.L #3,(A7)
  404.   MOVEM.L A0,(A7)        -> yeah! keep flags!
  405.   BGT.S noadjust
  406.   MOVE.L $4.W,A0
  407.   BTST #0,297(A0)
  408.   BNE.S noadjust
  409.   MOVE.L (A7),8(A7)        -> for 68000 long-format frames
  410.   ADDQ.L #8,A7
  411. noadjust:
  412.   LEA continue(PC),A0        -> finish superstate
  413.   MOVE.L 6(A7),-4(A0)
  414.   MOVE.W 4(A7),-6(A0)
  415.   MOVE.L A0,6(A7)
  416.   MOVE.L (A7)+,A0
  417.   RTE
  418.  
  419.   LONG 0
  420. pcstore:
  421.   LONG 0
  422. continue:
  423.   SUBQ.L #4,A7                -> make space for return
  424.   MOVEM.L D0-D7/A0-A6,-(A7)
  425.   LEA continue(PC),A0            -> pc,sr on the stack
  426.   MOVE.L -(A0),D0
  427.   MOVE.L -(A0),-(A7)
  428.   ADDQ.L #2,D0
  429.   MOVE.L D0,64(A7)            -> prepare return pc
  430.  
  431.   MOVE.L breakpoint(PC),D0        -> check for breakpoint
  432.   BEQ.S nobreak
  433.   CMP.L    pcstore(PC),D0
  434.   BEQ.S stophere
  435.  
  436. nobreak:
  437.   MOVE.L breakpointmem(PC),D0        -> check for breakpoint on mem
  438.   BEQ.S nomembreak
  439.   MOVE.L D0,A0
  440.   MOVE.L (A0),D0
  441.   CMP.L    memval(PC),D0
  442.   BNE.S stophere
  443.  
  444. nomembreak:
  445.   MOVE.L stepovera7(PC),D0        -> check for step over
  446.   BEQ.S stophere
  447.   CMPA.L stepovera5(PC),A5
  448.   BEQ.S stophere
  449.   CMPA.L D0,A7                -> we compare TOP of frame, not actual A7
  450.   BMI.S dontstop
  451.  
  452. stophere:
  453.   MOVE.L debuga4(PC),A4            -> restore A4
  454.   MOVE.L A7,-(A7)
  455.   MOVE.L codejmp(PC),A0
  456.   JSR (A0)                -> call E func with frame
  457.   ADDQ.L #4,A7
  458.   TST.L D0                -> see if we need to raise an exception
  459.   BNE.S raise
  460.  
  461. dontstop:
  462.   MOVE.L pcstore(PC), D0
  463.   LEA lastpc(PC), A0
  464.   MOVE.L D0, (A0)
  465.   MOVE.L (A7)+,D0
  466.   MOVEQ #-1,D1
  467.   MOVE.L $4.W,A6
  468.   JSR -144(A6)                -> SetSr(orig_sr,$FF)
  469.   MOVEM.L (A7)+,D0-D7/A0-A6        -> hold SR!
  470.   RTS                    -> retpc is on top!
  471.  
  472. raise:
  473.   ADDQ.L #4,A7                -> remove sr
  474.   MOVEM.L (A7)+,D0-D7/A0-A6        -> registers back
  475.   MOVE.L exc(PC),-84(A4)        -> fill programs' exception(-info)
  476.   MOVE.L excinfo(PC),-96(A4)
  477.   ReThrow()
  478.  
  479. codejmp: LONG 0
  480. debuga4: LONG 0
  481.  
  482. stepovera7: LONG 0
  483. stepovera5: LONG 0
  484.  
  485. breakpoint: LONG 0            -> 0=no break, -1=run, other=break
  486. breakpointmem: LONG 0            -> 0=no break, other=memaddress
  487. memval: LONG 0                -> value for breakpointmem
  488.  
  489. exc: LONG 0
  490. excinfo: LONG 0
  491.  
  492. -> Last known PC
  493. lastpc: LONG 0
  494.  
  495. EXPORT PROC stepover(a7=NIL,a5=NIL) IS PutLong({stepovera7},a7) BUT PutLong({stepovera5},a5)
  496. EXPORT PROC setbreak(a) IS PutLong({breakpoint},a)
  497. EXPORT PROC setmembreak(a) IS PutLong({breakpointmem},a) BUT PutLong({memval},IF a THEN Long(a) ELSE NIL)
  498. EXPORT PROC setthrow(e,ei) IS PutLong({exc},e) BUT PutLong({excinfo},ei)
  499.